home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / com / computer / casio_st / prog_fx / divers / calendri.sha < prev    next >
Encoding:
Text File  |  1994-03-01  |  1.1 KB  |  20 lines
  1. 1 REM (C) NEIBAF
  2. 10 CLS:PRINT "CALENDRIER PERPETUEL";
  3. 20 DIM J$(7),M$(12),JO(12)
  4. 30 RESTORE 140:FOR I=0 TO 6:READ J$(I):NEXT:FOR I=1 TO 12:READ M$(I),JO(I):NEXT
  5. 40 CLS:INPUT "Jour :",J:IF J<1 THEN 40 ELSE INPUT "Mois :",M:GOTO 160
  6. 50 INPUT "Annee :",A
  7. 60 CLS:PRINT "Le ";RIGHT$(STR$(J),2);"/";RIGHT$(STR$(M),2);"/";MID$(STR$(A),2,5)" correspond au";:PRINT :GOSUB 100
  8. 70 JS=FRAC((JD-1720977)/7)
  9. 80 JS=INT(7*(JS-INT(JS))+.001)
  10. 90 PRINT J$(JS);J;M$(M);A;:A$=INPUT$(1,@):IF A$=CHR$(13) THEN CLS:GOTO 40 ELSE CLS:ERASE M$,J$,M,A$:END
  11. 100 MAN=INT(.6+1/M+.001):MP=M+12*MAN:AP=A-MAN
  12. 110 JD=J+INT((367*(MP-1)+5)/12+.001)+INT(365.25*(AP+4712)+.001)
  13. 120 JD=JD-INT(AP/100)+INT(AP/400)
  14. 130 RETURN
  15. 140 DATA Dimanche,Lundi,Mardi,Mercredi,Jeudi,Vendredi,Samedi
  16. 150 DATA Janvier,31,Fevrier,29,Mars,31,Avril,30,Mai,31,Juin,30,Juillet,31,Aout,31,Septembre,30,Octobre,31,Novembre,30,Decembre,31
  17. 160 IF M>12 OR M<1 THEN CLS:BEEP:PRINT "Une annee compte 12 mois";:A$=INPUT$(1,@):GOTO 40
  18. 170 IF J>JO(M) OR J<1 THEN CLS:BEEP:PRINT "Il y a"JO(M)"jours en "M$(M);:A$=INPUT$(1,@):GOTO 40
  19. 180 GOTO 50
  20.